unit cx_procs;

interface
uses
Classes;

type

  TThreadUpdate = class(TThread)
  private
   FIsTerminated: Boolean;
   FContact : LongWord;
   //procedure CheckStatus;
  protected
    procedure Execute; override;
    //procedure UpdateRates;
  public
   constructor Create(aContact : LongWord = 0);
   property IsTerminated: Boolean read FIsTerminated;
  end;

function AddNewRateToCList: Integer;
procedure LoadRates;

function DateTimeStrEval(const DateTimeFormat : string;
                         const DateTimeStr : string) : TDateTime;

{
function cx_FormatString(pattern : string): string; overload;
function cx_FormatString(pattern : string; zContact : Integer): string; overload;
}
function cx_FormatString(pattern : string; zContact : Integer = 0): string;

procedure cx_UpdateRates(Stop: Boolean = false);
procedure UpdatePrecision;
procedure UpdateOneRate(zContact: THandle);
procedure UpdateCountry(vContact: THandle; New: Boolean = false);

implementation


uses
  m_globaldefs, m_api, dbsettings,
  cx_vars, cx_CBR.ru, cx_contacts, cx_google, cx_nbrb_by,
  cx_currencies,
  //Windows,
  SysUtils, DateUtils, StrUtils, Math;

constructor TThreadUpdate.Create(aContact : LongWord = 0);
begin
 inherited Create(true);
 Priority:=tpLowest;
 FreeOnTerminate:=false;
 FIsTerminated:=false;
 FContact:=aContact;
 Resume;
end;
{
procedure TThreadUpdate.CheckStatus;
begin
 if cx_Status=ID_STATUS_OFFLINE then
   Terminate;
end;
}
procedure TThreadUpdate.Execute;
 var
  i: Integer;
begin
 UpdatePrecision;
 if FContact=0 then
  begin
   LoadRates;
   i:=0;
   while (not Terminated) and (i<=High(cx_Clist)) do
    begin
     if cx_Clist[i].hContact<>0 then
       UpdateOneRate(cx_Clist[i].hContact);
     Inc(i);
    end;
   if Terminated  and (cx_Status=ID_STATUS_ONLINE) then
    while i<=High(cx_Clist) do
     begin
      cx_UpdateStatus(cx_Clist[i].hContact);
      Inc(i);
     end;
  end
 else
   UpdateOneRate(FContact);
 FIsTerminated:=true;
end;

procedure cx_UpdateRates(Stop: Boolean = false);
begin
 if cx_Status=ID_STATUS_OFFLINE then
   Exit;
 if Assigned(ThreadUpdate) then
  begin
   if ThreadUpdate.IsTerminated then
    begin
     FreeAndNil(ThreadUpdate);
     ThreadUpdate := TThreadUpdate.Create();
    end
   else
    begin
     if Stop then
       ThreadUpdate.Terminate;
    end;
  end
 else
   ThreadUpdate := TThreadUpdate.Create(); // initiate new thread for connection}
end;

procedure UpdatePrecision;
begin
 if DBGetSettingType(0, piShortName, cx_opt_Precision)=DBVT_DWORD then
   PrecisionValue:=DBGetContactSettingDWord(0, piShortName, cx_opt_Precision, PrecisionDefault)
 else
  begin
   PrecisionValue:=PrecisionDefault;
   DBWriteContactSettingDWord(0, piShortName, cx_opt_Precision, PrecisionValue);
  end;
 //
 cx_UnavailableText:=DBReadString(0, piShortName, cx_opt_Unavailable);
 if cx_UnavailableText='' then
   cx_UnavailableText:=UnavailableDef;
end;

procedure WriteRatesToDB(aContact: LongWord; ARates: TRates; NewRate: Boolean = true);
 var
  curdate,
  prevdate,
  nextdate: String;
begin
 if NewRate then
  begin
   DecimalSeparator:='.';

   DBWriteContactSettingString(aContact, piShortName, cx_ComingRate, PChar(FloatToStr(ARates.coming.rate)));
   DBWriteContactSettingString(aContact, piShortName, cx_CurrentRate, PChar(FloatToStr(ARates.current.rate)));

   DateTimeToString(nextdate,'dd/mm/yyyy',ARates.coming.date);
   DateTimeToString(curdate,'dd/mm/yyyy',ARates.current.date);

   DBWriteContactSettingString(aContact, piShortName, cx_ComingDate, PChar(nextdate));
   DBWriteContactSettingString(aContact, piShortName, cx_CurrentDate, PChar(curdate));
 end;
 DBWriteContactSettingString(aContact, piShortName, cx_PreviousRate, PChar(FloatToStr(ARates.previous.rate)));
 DateTimeToString(prevdate,'dd/mm/yyyy',ARates.previous.date);
 DBWriteContactSettingString(aContact, piShortName, cx_PreviousDate, PChar(prevdate));
 //
 DBWriteContactSettingString(aContact, piShortName, cx_LastUpdate, PChar(DateTimeToStr(Now)));
end;

procedure UpdateOneRate(zContact: LongWord);
var
  //response,
  source,
  currency,
  //name,
  statein{,
  curratestr,
  check}: string;
  //OutFile : Textfile;
  //amount  : integer;
  Rates, Rates2 : TRates;
  CurrentRate : real;
  //interval : integer;
  //
  ct: Integer;
 procedure CurrRateFromBase;
 begin
  Rates.current.rate:=StrToFloatDef(DBReadString(zContact,piShortName, cx_CurrentRate, nil), 0);
  Rates.current.date:=StrToDateDef(DBReadString(zContact,piShortName, cx_CurrentDate, nil), Today);
 end;
 procedure PrevRateFromBase(Reverse: Boolean = false);
 begin
  Rates.previous.rate:=StrToFloatDef(DBReadString(zContact,piShortName, cx_PreviousRate, nil), 0);
  Rates.previous.date:=StrToDateDef(DBReadString(zContact,piShortName, cx_PreviousDate, nil), Yesterday);
  //
  if Rates.previous.rate=0 then
   begin
    Rates.previous.rate:=CurrentRate;
    Rates.previous.date:=StrToDateTimeDef(DBReadString(zContact,piShortName, cx_CurrentDate, nil), Yesterday);
   end;
  //
  if Reverse and (Rates.previous.rate<>0) then
    Rates.previous.rate:=1/Rates.previous.rate;
 end;
begin
  //
  cx_Today := Today;
  cx_Tomorrow:=IncWeek(cx_Today,1);
  cx_DateFrom := IncWeek(cx_Today,-2);
  DateTimeToString(cx_TomorrowStr,'dd/mm/yyyy',cx_Tomorrow);
  DateTimeToString(cx_TodayStr,'dd/mm/yyyy',cx_Today);
  DateTimeToString(cx_DateFromStr,'dd/mm/yyyy',cx_DateFrom);

        try
          ClearRates(Rates);
          try
            Source:=DBReadString(zContact,piShortName,cx_Source,nil);
            //name:=  DBReadString(zContact,piShortName,cx_Nick,nil);
            currency:=DBReadString(zContact,piShortName,cx_Currency,nil);
            StateIn:=DBReadString(zContact,piShortName,cx_StateIn,nil);
            //curratestr:=AnsiReplaceStr(DBReadString(zContact,piShortName,cx_CurrentRate,nil),',','.');
            CurrRateFromBase;
            CurrentRate:=Rates.current.rate; //Fuck you Spielberg!!!
          except
            Rates.coming.rate:=0;
            Rates.current.rate:=0;
            Rates.previous.rate:=0;
            CurrentRate:=0;
          end;

          UpdateCountry(zContact);

          if Source='cbr.ru' then
            begin
              cx_UpdateStatus(zContact, ID_STATUS_OCCUPIED);
              //
              ct:=ConversionType(stateIn, currency, 'RUR');
              //MessageBox(0, PChar(IntToStr(ct)), piShortName, MB_OK or MB_ICONINFORMATION);
              //
              case ct of
               cx_RateDirect:
                begin
                 Rates:=CBRru_GetRate(currency);
                 if Rates.success then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase;
                   WriteRatesToDB(zContact, Rates);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               cx_RateReverse:
                begin
                 Rates:=CBRru_GetRate(stateIn);
                 if Rates.success then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase(true);
                   if Rates.coming.rate<>0 then
                     Rates.coming.rate:=1/Rates.coming.rate;
                   if Rates.current.rate<>0 then
                     Rates.current.rate:=1/Rates.current.rate;
                   if Rates.previous.rate<>0 then
                     Rates.previous.rate:=1/Rates.previous.rate;
                   WriteRatesToDB(zContact, Rates);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               cx_RateTransit:
                begin
                 Rates:=CBRru_GetRate(currency);
                 ClearRates(Rates2);
                 Rates2:=CBRru_GetRate(stateIn);
                 if (Rates.success) and (Rates2.success) then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase;
                   if Rates2.coming.rate<>0 then
                     Rates2.coming.rate:=Rates.coming.rate/Rates2.coming.rate;
                   if Rates2.current.rate<>0 then
                     Rates2.current.rate:=Rates.current.rate/Rates2.current.rate;
                   if Rates2.previous.rate<>0 then
                     Rates2.previous.rate:=Rates.previous.rate/Rates2.previous.rate;
                   WriteRatesToDB(zContact, Rates2);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               end;
              //ShowMessage('DB write succesfull.');
            end;
          if Source='nbrb.by' then
            begin
              cx_UpdateStatus(zContact, ID_STATUS_OCCUPIED);
              //
              ct:=ConversionType(stateIn, currency, 'BYR');
              //MessageBox(0, PChar(IntToStr(ct)), piShortName, MB_OK or MB_ICONINFORMATION);
              //
              case ct of
               cx_RateDirect:
                begin
                 Rates:=NBRBby_GetRate(currency);
                 if Rates.success then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase;
                   WriteRatesToDB(zContact, Rates);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               cx_RateReverse:
                begin
                 Rates:=NBRBby_GetRate(stateIn);
                 if Rates.success then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase(true);
                   if Rates.coming.rate<>0 then
                     Rates.coming.rate:=1/Rates.coming.rate;
                   if Rates.current.rate<>0 then
                     Rates.current.rate:=1/Rates.current.rate;
                   if Rates.previous.rate<>0 then
                     Rates.previous.rate:=1/Rates.previous.rate;
                   WriteRatesToDB(zContact, Rates);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               cx_RateTransit:
                begin
                 Rates:=NBRBby_GetRate(currency);
                 ClearRates(Rates2);
                 Rates2:=NBRBby_GetRate(stateIn);
                 if (Rates.success) and (Rates2.success) then
                  begin
                   if Rates.previous.rate=0 then
                     PrevRateFromBase;
                   if Rates2.coming.rate<>0 then
                     Rates2.coming.rate:=Rates.coming.rate/Rates2.coming.rate;
                   if Rates2.current.rate<>0 then
                     Rates2.current.rate:=Rates.current.rate/Rates2.current.rate;
                   if Rates2.previous.rate<>0 then
                     Rates2.previous.rate:=Rates.previous.rate/Rates2.previous.rate;
                   WriteRatesToDB(zContact, Rates2);
                   cx_UpdateContact(zContact);
                  end
                 else
                   cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
                end;
               end;
              //ShowMessage('DB write succesfull.');
            end;
          if source='Google' then
            begin
              cx_UpdateStatus(zContact, ID_STATUS_OCCUPIED);
              PrevRateFromBase;
              Rates:=google_getrate(currency, statein);
              if Rates.success then
               begin
                WriteRatesToDB(zContact, Rates, CurrentRate<>Rates.current.rate);
                cx_UpdateContact(zContact, CurrentRate<>Rates.current.rate);
               end
              else
                cx_UpdateStatus(zContact, ID_STATUS_INVISIBLE);
            end;
        except
         //TODO: Write additional error handling
         cx_UpdateStatus(zContact, ID_STATUS_NA);
        end;

end;

(*
procedure TThreadUpdate.UpdateRates;
 var
  //hContact : THandle;
  i: Integer;
begin
 //
 LoadRates;
 //
 {
 hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
 DecimalSeparator:='.';
  while hContact <> 0 do
  begin
    if IsContactProto(hContact, piShortName) = -1 Then
    begin
      UpdateOneRate(hContact);
    end;
  hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
  end;
 }
 for i:=0 to High(cx_Clist) do
  begin
   if cx_Clist[i].hContact<>0 then
     UpdateOneRate(cx_Clist[i].hContact);
  end;
end;
*)

{
function cx_FormatString(pattern : string): string;
begin
result:=AnsiReplaceStr(pattern,'%a','1405');
result:=AnsiReplaceStr(result,'%f','NZD');
result:=AnsiReplaceStr(result,'%t','AUD');
result:=AnsiReplaceStr(result,'%r','0.7884');
result:=AnsiReplaceStr(result,'%p','0.8013');
result:=AnsiReplaceStr(result,'%n','0.6945');
result:=AnsiReplaceStr(result,'%d',DateToStr(Now));
result:=AnsiReplaceStr(result,'%s','1107.702');
result:=AnsiReplaceStr(result,'%l','1125.8265');
result:=AnsiReplaceStr(result,'%c','975.7725');
result:=AnsiReplaceStr(result,'%m','Google');
end;
}

function cx_FormatString(pattern : string; zContact : Integer = 0): string;
 var
  amount,source,
  destination,CurRate,PrevRate,
  UpComRate,LastPollDate,
  StatedRate,PrevStatedRate,UpcomingStatedRate, ObtainFrom : string;
  rate: Double;
begin
//precision:=DBGetContactSettingDWord(0,piShortName,cx_opt_Precision,-2);
UpdatePrecision;
//
if zContact=0 then
 begin
  result:=AnsiReplaceStr(pattern,'%a','1405');
  result:=AnsiReplaceStr(result,'%f','NZD');
  result:=AnsiReplaceStr(result,'%t','AUD');
  result:=AnsiReplaceStr(result,'%r',CurrToStrF(0.7884, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%p',CurrToStrF(0.8013, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%n',CurrToStrF(0.6945, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%d',DateToStr(Now));
  result:=AnsiReplaceStr(result,'%s',CurrToStrF(1107.702, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%l',CurrToStrF(1125.8265, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%c',CurrToStrF(975.7725, ffFixed, PrecisionValue));
  result:=AnsiReplaceStr(result,'%m','Google');
 end
else
 begin
  amount:=inttostr(DBGetContactSettingDWord(zContact, piShortName, cx_Amount, 1));
  source:=DBReadString(zContact, piShortName, cx_Currency);
  destination:=DBReadString(zContact, piShortName, cx_StateIn);
  //
  CurRate:=DBReadString(zContact, piShortName, cx_CurrentRate);
  rate:=StrToFloatDef(CurRate, 0);
  if rate=0 then
   begin
    CurRate:=cx_UnavailableText;
    StatedRate:=cx_UnavailableText;
   end
  else
   begin
    CurRate:=CurrToStrF(rate, ffFixed, PrecisionValue);
    StatedRate:=CurrToStrF(rate*StrToInt(amount), ffFixed, PrecisionValue);
   end;
  PrevRate:=DBReadString(zContact, piShortName, cx_PreviousRate);
  rate:=StrToFloatDef(PrevRate, 0);
  if rate=0 then
   begin
    PrevRate:=cx_UnavailableText;
    PrevStatedRate:=cx_UnavailableText;
   end
  else
   begin
    PrevRate:=CurrToStrF(rate, ffFixed, PrecisionValue);
    PrevStatedRate:=CurrToStrF(rate*StrToInt(amount), ffFixed, PrecisionValue);
   end;
  UpComRate:=DBReadString(zContact, piShortName, cx_ComingRate);
  rate:=StrToFloatDef(UpComRate, 0);
  if rate=0 then
   begin
    UpComRate:=cx_UnavailableText;
    UpcomingStatedRate:=cx_UnavailableText;
   end
  else
   begin
    UpComRate:=CurrToStrF(rate, ffFixed, PrecisionValue);
    UpcomingStatedRate:=CurrToStrF(rate*StrToInt(amount), ffFixed, PrecisionValue);
   end;
  //
  LastPollDate:=DBReadString(zContact, piShortName, cx_LastUpdate);
  ObtainFrom:=DBReadString(zContact, piShortName, cx_Source);
  //
  result:=AnsiReplaceStr(pattern,'%a',amount);
  result:=AnsiReplaceStr(result,'%f',source);
  result:=AnsiReplaceStr(result,'%t',destination);
  result:=AnsiReplaceStr(result,'%r',CurRate);
  result:=AnsiReplaceStr(result,'%p',PrevRate);
  result:=AnsiReplaceStr(result,'%n',UpComRate);
  result:=AnsiReplaceStr(result,'%d',LastPollDate);
  result:=AnsiReplaceStr(result,'%s',StatedRate);
  result:=AnsiReplaceStr(result,'%l',PrevStatedRate);
  result:=AnsiReplaceStr(result,'%c',UpcomingStatedRate);
  result:=AnsiReplaceStr(result,'%m',ObtainFrom);
 end;

end;                                 


// =============================================================================
// function to add found contact to the list
// -----------------------------------------------------------------------------
(*
function AddToList(wParam: wParam; lParam: lParam): Integer; cdecl;
var psre: PPROTOSEARCHRESULT;
begin
  psre := PPROTOSEARCHRESULT(lParam); // it contains data of contact, user trying to add

  // values below will be required for authorization request
{  psre_id := StrToInt(String(PChar(psre.nick)));
  psre_secureid := String(PChar(psre.SecureID));}

//  Result := AddFriend(StrToInt(psre.id), psre.psr.nick, psre.Status, 0);

  // add the contact temporarily and invisibly, just to get user info or something
  If wParam = PALF_TEMPORARY Then
  Begin
    DBWriteContactSettingByte(Result, 'CList', 'NotOnList', 1);
		DBWriteContactSettingByte(Result, 'CList', 'Hidden', 1);
  End;
end;
*)
function AddNewRateToCList: Integer;
begin
 SetLength(cx_CList, Length(cx_CList)+1);
 Result:=High(cx_CList);
end;

procedure LoadRates;
var
  hContact: THandle;
  c : Integer;
begin
 SetLength(cx_Clist, 0);
 hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
 while hContact <> 0 do
  begin
   if IsContactProto(hContact, piShortName) = -1 Then
    begin
     c:=AddNewRateToCList;
     cx_CList[c].ID:=DBGetContactSettingDWord(hContact,piShortName,'ID',0);
     try
      cx_CList[c].Source:=DBReadString(hContact,piShortName,cx_Source,nil);
      cx_CList[c].Name:=DBReadString(hContact,piShortName,cx_Nick,nil);
      cx_CList[c].StateIn:=DBReadString(hContact,piShortName,cx_StateIn,nil);
      cx_CList[c].Amount:=DBGetContactSettingDWord(hContact,piShortName,cx_Amount,0);
      cx_CList[c].Currency:=DBReadString(hContact,piShortName,cx_Currency,nil);
      cx_CList[c].CurrentRate:=DBReadString(hContact,piShortName,cx_CurrentRate,nil);
      cx_CList[c].hContact:=hContact;
      cx_CList[c].Changes:=0;
      //0.3.0.6
      cx_CList[c].CC:=DBReadString(hContact,piShortName,cx_opt_ContactCaption,nil);
      cx_CList[c].SM:=DBReadString(hContact,piShortName,cx_opt_StatusMessage,nil);
     except
      //TODO: Write additional error handling
     end;
    end;
   hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
  end;
end;
{
function GetContactByID(uid: Integer): THandle;
var hContact: THandle;
begin
  Netlib_Log(cx_hNetlibUser, PChar('(GetContactByID) Searching contact by id: '+IntToStr(uid)+'...'));
  Result := 0;
  hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDFIRST, 0, 0);
        while hContact <> 0 do
  begin
    // by default MS_DB_CONTACT_FINDFIRST returns all contacts found
    // next line verifies that found contact belongs to our protocol
    if pluginLink^.CallService(MS_PROTO_ISPROTOONCONTACT, hContact, lParam(PChar(piShortName))) <> 0 Then
    begin
      if DBGetContactSettingDword(hContact, piShortName, 'ID', 0) = uid Then
        begin
          Netlib_Log(cx_hNetlibUser, PChar('(GetContactByID) ... found id: '+IntToStr(DBGetContactSettingDword(hContact, piShortName, 'ID', 0))+' - match found!'));
          Result := hContact;
          Exit;
        end;
      Netlib_Log(cx_hNetlibUser, PChar('(GetContactByID) ... found id: '+IntToStr(DBGetContactSettingDword(hContact, piShortName, 'ID', 0))+' - no match'));
    end;
    hContact := pluginLink^.CallService(MS_DB_CONTACT_FINDNEXT, hContact, 0);
end;
end;
}

//==================================================
//Function to read date in specified format
//==================================================

function DateTimeStrEval(const DateTimeFormat : string;
                         const DateTimeStr : string) : TDateTime;
var i,ii,iii : integer;
    Retvar : TDateTime;
    Tmp,
    Fmt,Data,Mask,Spec : string;
    Year,Month,Day,Hour,
    Minute,Second,MSec : word;
    AmPm : integer;
begin
  Year := 1;
  Month := 1;
  Day := 1;
  Hour := 0;
  Minute := 0;
  Second := 0;
  MSec := 0;
  Fmt := UpperCase(DateTimeFormat);
  Data := UpperCase(DateTimeStr);
  i := 1;
  Mask := '';
  AmPm := 0;

  while i < length(Fmt) do begin
    if Fmt[i] in ['A','P','D','M','Y','H','N','S','Z'] then begin
      // Start of a date specifier
      Mask  := Fmt[i];
      ii := i + 1;

      // Keep going till not valid specifier
      while true do begin
        if ii > length(Fmt) then Break; // End of specifier string
        Spec := Mask + Fmt[ii];

        if (Spec = 'DD') or (Spec = 'DDD') or (Spec = 'DDDD') or
           (Spec = 'MM') or (Spec = 'MMM') or (Spec = 'MMMM') or
           (Spec = 'YY') or (Spec = 'YYY') or (Spec = 'YYYY') or
           (Spec = 'HH') or (Spec = 'NN') or (Spec = 'SS') or
           (Spec = 'ZZ') or (Spec = 'ZZZ') or
           (Spec = 'AP') or (Spec = 'AM') or (Spec = 'AMP') or
           (Spec = 'AMPM') then begin
          Mask := Spec;
          inc(ii);
        end
        else begin
          // End of or Invalid specifier
          Break;
        end;
      end;

      // Got a valid specifier ? - evaluate it from data string
      if (Mask <> '') and (length(Data) > 0) then begin
        // Day 1..31
        if (Mask = 'DD') then begin
           Day := StrToIntDef(trim(copy(Data,1,2)),0);
           delete(Data,1,2);
        end;

        // Day Sun..Sat (Just remove from data string)
        if Mask = 'DDD' then delete(Data,1,3);

        // Day Sunday..Saturday (Just remove from data string LEN)
        if Mask = 'DDDD' then begin
          Tmp := copy(Data,1,3);
          for iii := 1 to 7 do begin
            if Tmp = Uppercase(copy(LongDayNames[iii],1,3)) then begin
              delete(Data,1,length(LongDayNames[iii]));
              Break;
            end;
          end;
        end;

        // Month 1..12
        if (Mask = 'MM') then begin
           Month := StrToIntDef(trim(copy(Data,1,2)),0);
           delete(Data,1,2);
        end;

        // Month Jan..Dec
        if Mask = 'MMM' then begin
          Tmp := copy(Data,1,3);
          for iii := 1 to 12 do begin
            if Tmp = Uppercase(copy(LongMonthNames[iii],1,3)) then begin
              Month := iii;
              delete(Data,1,3);
              Break;
            end;
          end;
        end;


        // Month January..December
        if Mask = 'MMMM' then begin
          Tmp := copy(Data,1,3);
          for iii := 1 to 12 do begin
            if Tmp = Uppercase(copy(LongMonthNames[iii],1,3)) then begin
              Month := iii;
              delete(Data,1,length(LongMonthNames[iii]));
              Break;
            end;
          end;
        end;

        // Year 2 Digit
        if Mask = 'YY' then begin
          Year := StrToIntDef(copy(Data,1,2),0);
          delete(Data,1,2);
          if Year < TwoDigitYearCenturyWindow then
            Year := (YearOf(Date) div 100) * 100 + Year
          else
            Year := (YearOf(Date) div 100 - 1) * 100 + Year;
        end;

        // Year 4 Digit
        if Mask = 'YYYY' then begin
          Year := StrToIntDef(copy(Data,1,4),0);
          delete(Data,1,4);
        end;

        // Hours
        if Mask = 'HH' then begin
           Hour := StrToIntDef(trim(copy(Data,1,2)),0);
           delete(Data,1,2);
        end;

        // Minutes
        if Mask = 'NN' then begin
           Minute := StrToIntDef(trim(copy(Data,1,2)),0);
           delete(Data,1,2);
        end;

        // Seconds
        if Mask = 'SS' then begin
           Second := StrToIntDef(trim(copy(Data,1,2)),0);
           delete(Data,1,2);
        end;

        // Milliseconds
        if (Mask = 'ZZ') or (Mask = 'ZZZ') then begin
           MSec := StrToIntDef(trim(copy(Data,1,3)),0);
           delete(Data,1,3);
        end;


        // AmPm A or P flag
        if (Mask = 'AP') then begin
           if Data[1] = 'A' then
             AmPm := -1
           else
             AmPm := 1;
           delete(Data,1,1);
        end;

        // AmPm AM or PM flag
        if (Mask = 'AM') or (Mask = 'AMP') or (Mask = 'AMPM') then begin
           if copy(Data,1,2) = 'AM' then
             AmPm := -1
           else
             AmPm := 1;
           delete(Data,1,2);
        end;

        Mask := '';
        i := ii;
      end;
    end
    else begin
      // Remove delimiter from data string
      if length(Data) > 1 then delete(Data,1,1);
      inc(i);
    end;
  end;

  if AmPm = 1 then Hour := Hour + 12;
  if not TryEncodeDateTime(Year,Month,Day,Hour,Minute,Second,MSec,Retvar) then
    Retvar := 0.0;
  Result := Retvar;
end;

procedure UpdateCountry(vContact: LongWord; New: Boolean = false);
 var
  Source: String;
  Country: Word;
begin
 if New then
   Country:=0
 else
   Country:=DBGetContactSettingWord(vContact, piShortName, cx_Country, 0);
 if Country=0 then
  begin
   Source:=DBReadString(vContact, piShortName, cx_Source);
   if Source='Google' then
     DBWriteContactSettingWord(vContact, piShortName, cx_Country, 1);
   if Source='cbr.ru' then
     DBWriteContactSettingWord(vContact, piShortName, cx_Country, 7);
   if Source='nbrb.by' then
     DBWriteContactSettingWord(vContact, piShortName, cx_Country, 375);
  end;
end;


end.
